home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / mathi2.zip / MATHI2.PRL next >
Text File  |  1993-01-14  |  12KB  |  330 lines
  1. #!/usr/local/bin/perl --    # -*-Perl-*-
  2. # this perl script converts mathematica PostScript output into
  3. # a format idraw can read.  Rich@rice.edu
  4. # Zdravko Balorda <zdravc@robo.fer.yu> added 3D graphics. (Metetra,
  5. # fill...)  and the idea about line widths.
  6. # Rich added support for mathematica version 2.1. 
  7. @x = ();
  8. @y = ();
  9. $max_no_of_points = 300;
  10. $x_min = 1 * 72;
  11. $x_wid = 7 * 72;
  12. $y_min = 3.5 * 72;
  13. $y_wid = 7.5 * 72;
  14. $brush=1;
  15. $poly_gray=1;
  16.  
  17. $text_pre = <<_asdf_asdf_asdf_;
  18. Begin %I Text
  19. %I cfg Black
  20. 0 0 0 SetCFg
  21. %I f *helvetica-bold-r*-24-*
  22. /Helvetica-Bold 24 SetF
  23. %I t
  24. _asdf_asdf_asdf_
  25.  
  26. $mline_pre = <<_asdf_asdf_asdf_;
  27. Begin %I MLine
  28. %I b 65535
  29. _asdf_asdf_asdf_
  30. $mline_tra = <<_asdf_asdf_asdf_;
  31.  0 0 [] 0 SetB
  32. %I cfg Black
  33. 0 0 0 SetCFg
  34. %I cbg White
  35. 1 1 1 SetCBg
  36. none SetP %I p n
  37. %I t
  38. [ 0.01 0 0 0.01 $x_min $y_min ] concat
  39. _asdf_asdf_asdf_
  40.  
  41. $poly_pre = <<_asdf_asdf_asdf_;
  42. Begin %I Poly
  43. %I b 65535
  44. _asdf_asdf_asdf_
  45. $poly_tra = <<_asdf_asdf_asdf_;
  46.  0 0 [] 1 SetB 
  47. %I cfg Black
  48. 0 0 0 SetCFg
  49. %I cbg White
  50. 1 1 1 SetCBg
  51. %I p
  52. _asdf_asdf_asdf_
  53. $poly_gray_tra = <<_asdf_asdf_asdf_;
  54.  SetP
  55. %I t
  56. [ 0.01 0 0 0.01 $x_min $y_min ] concat
  57. _asdf_asdf_asdf_
  58.  
  59. $fill_mline_pre = <<_asdf_asdf_asdf_;
  60. Begin %I MLine
  61. none SetB %I b n
  62. %I cfg Black
  63. 0 0 0 SetCFg
  64. %I cbg White
  65. 1 1 1 SetCBg
  66. %I p
  67. _asdf_asdf_asdf_
  68. $fill_mline_tra = <<_asdf_asdf_asdf_;
  69.  SetP
  70. %I t
  71. [ 0.01 0 0 0.01 $x_min $y_min ] concat
  72. _asdf_asdf_asdf_
  73.  
  74. $header = <<_asdf_asdf_asdf_;
  75. %! PS-Adobe-2.0 EPSF-1.2
  76. %%DocumentFonts: Helvetica-Bold
  77. %%BoundingBox: $x_min $y_min $x_wid $y_wid
  78. %%EndComments
  79. 50 dict begin /arrowHeight 8 def /arrowWidth 4 def /none null def
  80. /numGraphicParameters 17 def /stringLimit 65535 def /Begin{save
  81. numGraphicParameters dict begin}def /End{end restore}def /SetB{dup type
  82. /nulltype eq{pop false /brushRightArrow idef false /brushLeftArrow idef true
  83. /brushNone idef}{/brushDashOffset idef /brushDashArray idef 0 ne
  84. /brushRightArrow idef 0 ne /brushLeftArrow idef /brushWidth idef false
  85. /brushNone idef}ifelse}def /SetCFg{/fgblue idef /fggreen idef /fgred idef}def
  86. /SetCBg{/bgblue idef /bggreen idef /bgred idef}def /SetF{/printSize idef
  87. /printFont idef}def /SetP{dup type /nulltype eq{pop true /patternNone idef}{
  88. /patternGrayLevel idef patternGrayLevel -1 eq{/patternString idef}if false
  89. /patternNone idef}ifelse}def /BSpl{0 begin storexyn newpath n 1 gt{0 0 0 0 0 0
  90. 1 1 true subspline n 2 gt{0 0 0 0 1 1 2 2 false subspline 1 1 n 3 sub{/i exch
  91. def i 1 sub dup i dup i 1 add dup i 2 add dup false subspline}for n 3 sub dup
  92. n 2 sub dup n 1 sub dup 2 copy false subspline}if n 2 sub dup n 1 sub dup 2
  93. copy 2 copy false subspline patternNone not brushLeftArrow not brushRightArrow
  94. not and and{ifill}if brushNone not{istroke}if 0 0 1 1 leftarrow n 2 sub dup n
  95. 1 sub dup rightarrow}if end}dup 0 4 dict put def /Circ{newpath 0 360 arc
  96. patternNone not{ifill}if brushNone not{istroke}if}def /CBSpl{0 begin dup 2 gt{
  97. storexyn newpath n 1 sub dup 0 0 1 1 2 2 true subspline 1 1 n 3 sub{/i exch
  98. def i 1 sub dup i dup i 1 add dup i 2 add dup false subspline}for n 3 sub dup
  99. n 2 sub dup n 1 sub dup 0 0 false subspline n 2 sub dup n 1 sub dup 0 0 1 1
  100. false subspline patternNone not{ifill}if brushNone not{istroke}if}{Poly}
  101. ifelse end}dup 0 4 dict put def /Elli{0 begin newpath 4 2 roll translate scale
  102. 0 0 1 0 360 arc patternNone not{ifill}if brushNone not{istroke}if end}dup 0 1
  103. dict put def /Line{0 begin 2 storexyn newpath x 0 get y 0 get moveto x 1 get y
  104. 1 get lineto brushNone not{istroke}if 0 0 1 1 leftarrow 0 0 1 1 rightarrow end
  105. }dup 0 4 dict put def /MLine{0 begin storexyn newpath n 1 gt{x 0 get y 0 get
  106. moveto 1 1 n 1 sub{/i exch def x i get y i get lineto}for patternNone not
  107. brushLeftArrow not brushRightArrow not and and{ifill}if brushNone not{istroke}
  108. if 0 0 1 1 leftarrow n 2 sub dup n 1 sub dup rightarrow}if end}dup 0 4 dict
  109. put def /Poly{3 1 roll newpath moveto -1 add{lineto}repeat closepath
  110. patternNone not{ifill}if brushNone not{istroke}if}def /Rect{0 begin /t exch
  111. def /r exch def /b exch def /l exch def newpath l b moveto l t lineto r t
  112. lineto r b lineto closepath patternNone not{ifill}if brushNone not{istroke}if
  113. end}dup 0 4 dict put def /Text{ishow}def /idef{dup where{pop pop pop}{exch def
  114. }ifelse}def /ifill{0 begin gsave patternGrayLevel -1 ne{fgred bgred fgred sub
  115. patternGrayLevel mul add fggreen bggreen fggreen sub patternGrayLevel mul add
  116. fgblue bgblue fgblue sub patternGrayLevel mul add setrgbcolor eofill}{eoclip
  117. originalCTM setmatrix pathbbox /t exch def /r exch def /b exch def /l exch def
  118. /w r l sub ceiling cvi def /h t b sub ceiling cvi def /imageByteWidth w 8 div
  119. ceiling cvi def /imageHeight h def bgred bggreen bgblue setrgbcolor eofill
  120. fgred fggreen fgblue setrgbcolor w 0 gt h 0 gt and{l b translate w h scale w h
  121. true[w 0 0 h neg 0 h]{patternproc}imagemask}if}ifelse grestore end}dup 0 8
  122. dict put def /istroke{gsave brushDashOffset -1 eq{[]0 setdash 1 setgray}{
  123. brushDashArray brushDashOffset setdash fgred fggreen fgblue setrgbcolor}
  124. ifelse brushWidth setlinewidth originalCTM setmatrix stroke grestore}def
  125. /ishow{0 begin gsave fgred fggreen fgblue setrgbcolor /fontDict printFont
  126. findfont printSize scalefont dup setfont def /descender fontDict begin 0[
  127. FontBBox]1 get FontMatrix end transform exch pop def /vertoffset 0 descender
  128. sub printSize sub printFont /Courier ne printFont /Courier-Bold ne and{1 add}
  129. if def{0 vertoffset moveto show /vertoffset vertoffset printSize sub def}
  130. forall grestore end}dup 0 3 dict put def /patternproc{0 begin
  131. /patternByteLength patternString length def /patternHeight patternByteLength 8
  132. mul sqrt cvi def /patternWidth patternHeight def /patternByteWidth
  133. patternWidth 8 idiv def /imageByteMaxLength imageByteWidth imageHeight mul
  134. stringLimit patternByteWidth sub min def /imageMaxHeight imageByteMaxLength
  135. imageByteWidth idiv patternHeight idiv patternHeight mul patternHeight max def
  136. /imageHeight imageHeight imageMaxHeight sub store /imageString imageByteWidth
  137. imageMaxHeight mul patternByteWidth add string def 0 1 imageMaxHeight 1 sub{
  138. /y exch def /patternRow y patternByteWidth mul patternByteLength mod def
  139. /patternRowString patternString patternRow patternByteWidth getinterval def
  140. /imageRow y imageByteWidth mul def 0 patternByteWidth imageByteWidth 1 sub{/x
  141. exch def imageString imageRow x add patternRowString putinterval}for}for
  142. imageString end}dup 0 12 dict put def /min{dup 3 2 roll dup 4 3 roll lt{exch}
  143. if pop}def /max{dup 3 2 roll dup 4 3 roll gt{exch}if pop}def /arrowhead{0
  144. begin transform originalCTM itransform /taily exch def /tailx exch def
  145. transform originalCTM itransform /tipy exch def /tipx exch def /dy tipy taily
  146. sub def /dx tipx tailx sub def /angle dx 0 ne dy 0 ne or{dy dx atan}{90}
  147. ifelse def gsave originalCTM setmatrix tipx tipy translate angle rotate
  148. newpath 0 0 moveto arrowHeight neg arrowWidth 2 div lineto arrowHeight neg
  149. arrowWidth 2 div neg lineto closepath patternNone not{originalCTM setmatrix
  150. /padtip arrowHeight 2 exp 0.25 arrowWidth 2 exp mul add sqrt brushWidth mul
  151. arrowWidth div def /padtail brushWidth 2 div def tipx tipy translate angle
  152. rotate padtip 0 translate arrowHeight padtip add padtail add arrowHeight div
  153. dup scale arrowheadpath ifill}if brushNone not{originalCTM setmatrix tipx tipy
  154. translate angle rotate arrowheadpath istroke}if grestore end}dup 0 9 dict put
  155. def /arrowheadpath{newpath 0 0 moveto arrowHeight neg arrowWidth 2 div lineto
  156. arrowHeight neg arrowWidth 2 div neg lineto closepath}def /leftarrow{0 begin y
  157. exch get /taily exch def x exch get /tailx exch def y exch get /tipy exch def
  158. x exch get /tipx exch def brushLeftArrow{tipx tipy tailx taily arrowhead}if
  159. end}dup 0 4 dict put def /rightarrow{0 begin y exch get /tipy exch def x exch
  160. get /tipx exch def y exch get /taily exch def x exch get /tailx exch def
  161. brushRightArrow{tipx tipy tailx taily arrowhead}if end}dup 0 4 dict put def
  162. /midpoint{0 begin /y1 exch def /x1 exch def /y0 exch def /x0 exch def x0 x1
  163. add 2 div y0 y1 add 2 div end}dup 0 4 dict put def /thirdpoint{0 begin /y1
  164. exch def /x1 exch def /y0 exch def /x0 exch def x0 2 mul x1 add 3 div y0 2 mul
  165. y1 add 3 div end}dup 0 4 dict put def /subspline{0 begin /movetoNeeded exch
  166. def y exch get /y3 exch def x exch get /x3 exch def y exch get /y2 exch def x
  167. exch get /x2 exch def y exch get /y1 exch def x exch get /x1 exch def y exch
  168. get /y0 exch def x exch get /x0 exch def x1 y1 x2 y2 thirdpoint /p1y exch def
  169. /p1x exch def x2 y2 x1 y1 thirdpoint /p2y exch def /p2x exch def x1 y1 x0 y0
  170. thirdpoint p1x p1y midpoint /p0y exch def /p0x exch def x2 y2 x3 y3 thirdpoint
  171. p2x p2y midpoint /p3y exch def /p3x exch def movetoNeeded{p0x p0y moveto}if
  172. p1x p1y p2x p2y p3x p3y curveto end}dup 0 17 dict put def /storexyn{/n exch
  173. def /y n array def /x n array def n 1 sub -1 0{/i exch def y i 3 2 roll put x
  174. i 3 2 roll put}for}def
  175. %%EndProlog
  176.  
  177. %I Idraw 7
  178.  
  179. Begin
  180. %I b u
  181. %I cfg u
  182. %I cbg u
  183. %I f u
  184. %I p u
  185. %I t
  186. [ 0.8 0 0 0.8 0 0 ] concat
  187. /originalCTM matrix currentmatrix def
  188.  
  189. _asdf_asdf_asdf_
  190. $trailer = <<_asdf_asdf_asdf_;
  191. End %I eop
  192.  
  193. showpage
  194.  
  195. %%Trailer
  196.  
  197. end
  198. _asdf_asdf_asdf_
  199.  
  200. sub put_point
  201. {
  202.   local($xp, $yp) = @_;
  203.   push (@x, int($x_min + 100 * $x_wid * $xp));
  204.   push (@y, int($y_min + 100 * $y_wid * $yp));
  205.   if ($max_no_of_points < $#x) {
  206.     &output_line();
  207.   }
  208. }
  209.  
  210. sub output_line
  211. {
  212.   if (0 < $#x) {
  213.     print $mline_pre;
  214.     print $brush;
  215.     print $mline_tra;
  216.     print "%I ", 1 + $#x, "\n";
  217.     foreach $n (0 .. $#x) {
  218.       print $x[$n], " ", $y[$n], "\n";
  219.     }
  220.     print 1 + $#x, " MLine\n";
  221.     print "End\n\n";
  222.     @x = ();
  223.     @y = ();
  224.   }
  225. }
  226.  
  227. sub output_filled_line
  228. {
  229.   if (0 < $#x) {
  230.     print $fill_mline_pre;
  231.     print $poly_gray;
  232.     print $fill_mline_tra;
  233.     print "%I ", 1 + $#x, "\n";
  234.     foreach $n (0 .. $#x) {
  235.       print $x[$n], " ", $y[$n], "\n";
  236.     }
  237.     print 1 + $#x, " MLine\n";
  238.     print "End\n\n";
  239.     @x = ();
  240.     @y = ();
  241.   }
  242. }
  243.  
  244. sub output_poly
  245. {
  246.   if (0 < $#x) {
  247.     print $poly_pre;
  248.     print $brush;
  249.     print $poly_tra;
  250.     print $poly_gray;
  251.     print $poly_gray_tra;
  252.  
  253.     print "%I ", 1 + $#x, "\n";
  254.     foreach $n (0 .. $#x) {
  255.       print $x[$n], " ", $y[$n], "\n";
  256.     }
  257.     print 1 + $#x, " Poly\n";
  258.     print "End\n\n";
  259.     @x = ();
  260.     @y = ();
  261.   }
  262. }
  263.  
  264. sub output_text
  265. {
  266.   local($t, $xp, $yp, $xc, $yc) = @_;
  267.   print $text_pre;
  268.   print "[ 1 0 0 1 ", int($x_min + $x_wid * $xp + 12 * (-.5 - .8 * length($t) * $xc)),
  269.     " ", int($y_min + $y_wid * $yp + 12 * (1 - $yc/2)), " ] concat\n";
  270.   print<<_asdf_asdf_asdf_;
  271. %I
  272. [
  273. ($t)
  274. ] Text
  275. End
  276.  
  277. _asdf_asdf_asdf_
  278. }
  279.  
  280. print $header;
  281. while (<>) {
  282.   if ((s/([\d\.]*)\s+setlinewidth//) || (s/([\d\.]*)\s+w$//)) {
  283.       &output_line();
  284.       $brush = int($1*800);
  285.     } elsif ((s/([\d\.]*)\s+setgray//) || (s/([\d\.]*)\s+g$//)) {
  286.       $poly_gray = $1;
  287.     } elsif (s/([\d\.]*)\s+([\d\.]*)\s+([\d\.]*)\s+setrgbcolor//) {
  288.       $poly_gray = 0.3*$1+0.59*$2+0.11*$3;
  289.     } elsif (s/ fill//) {
  290.       &output_filled_line();
  291.     } elsif (s/([-\d\.]*)\s+([-\d\.]*)\s+([-\d\.]*)\s+([-\d\.]*)\s+([-\d\.]*)\s+([-\d\.]*)\s+([-\d\.]*)\s+([-\d\.]*)\s+Metetra//) {
  292.       &output_line();
  293.       &put_point ($1,$2);
  294.       &put_point ($3,$4);
  295.       &put_point ($5,$6);
  296.       &put_point ($7,$8);
  297.       &output_poly();
  298.     } elsif ((s/([-\d\.]*)\s+([-\d\.]*)\s+moveto//) ||
  299.          (s/([-\d\.]*)\s+([-\d\.]*)\s+m$//)) {    
  300.       &output_line();
  301.       &put_point ($1, $2);
  302.     } elsif ((s/([-\d\.]*)\s+([-\d\.]*)\s+lineto//) ||
  303.          (s/([-\d\.]*)\s+([-\d\.]*)\s+L$//)) {
  304.       &put_point ($1, $2);
  305.     } elsif ((s/^newpath//) || (s/\s+newpath//)) {
  306.       @x = ();
  307.       @y = ();
  308.     } elsif ((s/^stroke//) || (s/\s+stroke//) || (s/^s$//)) {
  309.       &output_line();
  310.     } elsif (s/\[\((.*)\)\]\s+([-\d\.]*)\s+([-\d\.]*)\s+([-\d\.]*)\s+([-\d\.]*)\s+Mshowa//) {
  311.       &output_line();
  312.       &output_text($1, $2, $3, $4, $5);
  313.     } elsif (s/([-\d\.]*)\s+([-\d\.]*)\s+Mdot//) {
  314.       &output_line();
  315.       &put_point ($1,$2);
  316.       &put_point ($1,$2);
  317.       &output_poly();
  318.     } else {
  319. #      print "%?: " , $_;
  320.     }
  321. }
  322. &output_line();
  323. print $trailer;
  324.  
  325. exit 0;
  326. ################################################################
  327. # local variables:
  328. # compile-command: "./math2plot.perl <~lemoore/Mathemat.1"
  329. # end:
  330.